package Nagios3::Plugin;

use warnings;
use strict;
use Carp;
use Exporter 'import';

our $VERSION = '0.1.8';
our @EXPORT  = qw(OK WARNING CRITICAL UNKNOWN DEPENDENT);

use constant {
    OK        => 0,
    WARNING   => 1,
    CRITICAL  => 2,
    UNKNOWN   => 3,
    DEPENDENT => 4,
};

sub _parse_status {
    my $val = shift;
    my ($res, $res_txt)
        = $val eq OK       || uc($val) eq 'OK'       ? (OK,       'OK')
        : $val eq WARNING  || uc($val) eq 'WARNING'  ? (WARNING,  'WARNING')
        : $val eq CRITICAL || uc($val) eq 'CRITICAL' ? (CRITICAL, 'CRITICAL')
        : $val eq UNKNOWN  || uc($val) eq 'UNKNOWN'  ? (UNKNOWN,  'UNKNOWN')
        : $val eq DEPENDENT
        || uc($val) eq 'DEPENDENT' ? (DEPENDENT, 'DEPENDENT')
        :                            (UNKNOWN,   'UNKNOWN');
    return wantarray ? ($res, $res_txt) : $res_txt;
}

sub new {
    my $this  = shift;
    my $class = ref($this) || $this;
    my $id    = shift;
    my $self  = {
        output      => [],
        long_output => [],
        buffer      => [],
        id          => defined $id ? $id : '',
        stat        => {},
        result      => UNKNOWN,
    };
    bless($self, $class);
    return $self;
}

sub is_in_range {
    my $self = shift;
    my $value = shift;
    my $range = shift;
    if (my ($inside, $low, $high) = $range =~ /
        ^(@)?       # optional 'inside' range
        (?:(.*):)?  # optional lower bound
        (.*)        # higher bound
        $/sx) {
        $low = 0 if not defined $low or $low eq '';
        my $res;
        if ($high eq '~') {
            $res = 0
        } elsif ($low eq '~') {
            if ($high eq '') {
                $res = 1;
            } else {
                $res = $value <= $high;
            }
        } elsif ($high eq '') {
            $res = $low <= $value;
        } else {
            $res = $low <= $value && $value <= $high;
        }
        return $inside ? !$res : $res
    } else {
        return 0
    }
}

sub printf {
    my $self = shift;
    my $msg  = shift;
    $msg = sprintf($msg, @_) if @_;
    push(@{$self->{output}}, $msg);
    return $self;
}

sub long_printf {
    my $self = shift;
    my $msg  = shift;
    $msg = sprintf($msg, @_) if @_;
    push(@{$self->{long_output}}, $msg);
    return $self;
}

sub push_msg {
    my $self = shift;
    if (defined $_[$#_] and ref($_[$#_]) eq 'HASH') {
        my $opt = pop;
    }
    my $msg = shift;
    $msg = sprintf($msg, @_) if @_;
    push(@{$self->{buffer}}, $msg);
    return $self;
}

sub join_msg {
    my $self = shift;
    my $sep  = shift;
    my $msg  = join($sep, @{$self->{buffer}});
    $self->{buffer} = [];
    push(@{$self->{output}}, $msg);
    return $self;
}

sub id {
    my $self = shift;
    my $id   = shift;
    if ($id) {
        $self->{id} = $id;
        return $self;
    } else {
        return $self->{id};
    }
}

sub status {
    my $self = shift;
    my $val  = shift;
    if (defined $val) {
        $self->{result} = $val;
        return $self;
    } else {
        my ($res, $res_txt) = _parse_status($self->{result});
        return wantarray ? ($res, $res_txt) : $res_txt;
    }
}

sub raise_status {
    my $self = shift;
    my $val  = shift;
    my ($new_status, $new_status_txt) = _parse_status($val);
    my ($old_status, $old_status_txt) = $self->status;
    $self->status($val) if $new_status > $old_status;
}

sub perf_data {
    my $self  = shift;
    my $name  = shift;
    my $value = shift;
    my $opt   = shift;
    $self->{stat}->{$name}->{value} = $value if defined $value;
    if (defined $opt) {
        croak "opt is not a HASHREF" if ref($opt) ne 'HASH';
        foreach (qw(unit warn crit min max)) {
            $self->{stat}->{$name}->{$_} = $opt->{$_} if defined $opt->{$_};
        }
    }
    return $self;
}

sub exit {
    my $self = shift;
    if (defined $_[$#_] and ref($_[$#_]) eq 'HASH') {
        my $opt = pop;
    }
    my $status = shift;
    my $msg    = shift;

    $self->join_msg(', ');
    $self->status($status) if defined $status;
    $self->printf($msg, @_) if defined $msg;

    my ($res, $res_txt) = $self->status;
    my $output = join(" ", @{$self->{output}});
    $output =~ s/\s+/ /g;
    $output =~ s/^\s+//;
    $output =~ s/\s+$//;

    my $long_output = join("\n", @{$self->{long_output}});
    $long_output =~ s/^\s+//s;
    $long_output =~ s/\s+$//s;

    my @pd = ();
    while (my ($k, $v) = each %{$self->{stat}}) {
        $_ = $v->{value};
        $_ .= $v->{unit} if defined $v->{unit} and $v->{unit} ne '';
        $_ .= ';' . join(';',
            map {exists $v->{$_} ? $v->{$_} : ''} qw(warn crit min max)
        );
        s/;+$//;
        s/'/''/g;
        $k = "'$k'" if $k =~ /[\s=']/;
        push @pd, join('=', $k, $_);
    }
    $output .= '|' . join(" ", @pd) if scalar @pd;
    printf "%s %s - %s\n", $self->{id}, $res_txt, $output;
    print $long_output, "\n" if defined $long_output and $long_output ne '';

    exit $res;
}

1;

=pod

=head1 NAME

Nagios3::Plugin - Module for Nagios3 plugins

=head1 VERSION

Version 0.1.3

=head1 SYNOPSIS

Nagios3::Plugin

    use S3::Nagios3::Plugin;

    my $nagios = Nagios3::Plugin->new();
    ...

=head1 METHODS

=head2 new([IDENT])

Nagios3::Plugin constructor. This class method takes an optional parameter
that define the "identifier" of the resulting plugin object.

=head2 id([IDENT])

Sets or gets the identifier of the plugin object

=head2 is_in_range(VALUE,RANGE)

This method returns 1 (true) if the VALUE is in the RANGE. The RANGE is defined
according to the Nagios Developer Guidelines: L<http://nagiosplug.sourceforge.net/developer-guidelines.html#THRESHOLDFORMAT>

=head2 exit([STATUS[,MESSAGE[,ARGUMENT...]]])

Terminates the plugin and optionnaly set the STATUS and append the MESSAGE.
STATUS is either given as a string (e.g. "CRITICAL") a number (e.g. 2) or
a constant defined in this module (e.g. CRITICAL). The MESSAGE can also
be a format (processed by C<sprintf>) for the optional ARGUMENTs.

If messages have been pushed to the plugin (using the push_msg method), they
are automatically joined using a single space and appened to the output of the
plugin (before the MESSAGE).

=head2 printf(MESSAGE[,ARGUMENT...])

Append the MESSAGE to the output of the plugin. The MESSAGE can also
be a format (processed by C<sprintf>) for the optional ARGUMENTs.

=head2 long_printf(MESSAGE[,ARGUMENT...])

Append the MESSAGE to the long output of the plugin. The MESSAGE can also
be a format (processed by C<sprintf>) for the optional ARGUMENTs.

=head2 push_msg(MESSAGE[,ARGUMENT...])

Pushes the MESSAGE into a buffer. The buffer can then be joined and append 
to the output of the plugin (see the join_msg method). The MESSAGE can also
be a format (processed by C<sprintf>) for the optional ARGUMENTs.

=head2 join_msg([SEP])

If messages have been pushed to the plugin (using the push_msg method), this
method joins them using the string SEP (default to a single space) and
appeneds the result to the output of the plugin.

=head2 status([STATUS])

Set or get the status of the plugin. If STATUS is given then this method sets
the status. STATUS can be either a string (e.g. "CRITICAL") a number
(e.g. 2) or a constant defined in this module (e.g. CRITICAL).

Without argument, this method returns the current status. In array context,
it returns the status number and the status string (e.g. (0, "OK")). In scalar
context, it only returns the status sting.

=head2 raise_status(STATUS)

Set the status if STATUS is "worst" than the current status. STATUS can
be either a string (e.g. "CRITICAL") a number (e.g. 2) or a constant
defined in this module (e.g. CRITICAL).

DEPENDENT is worst than UNKNOWN, UNKNOWN is worst than CRITICAL, CRITICAL
is worst than WARNING and WARNING is worst than OK.

=head2 perf_data(NAME,VALUE[,OPT])

Set performance data according to the Nagios Developer Guidelines:
L<http://nagiosplug.sourceforge.net/developer-guidelines.html#AEN203>. OPT
is an optional opton hashref with the following possible keys: "unit,
warn, crit, min, max"

=head1 AUTHOR

Jacques Supcik, C<< <jacques at supcik.org> >>

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Nagios3::Plugin

=head1 COPYRIGHT

Copyright 2009 Jacques Supcik

Licensed under the Apache License, Version 2.0 (the "License"); you may
not use this file except in compliance with the License. You may obtain
a copy of the License at

  http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS, WITHOUT
WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the
License for the specific language governing permissions and limitations
under the License.

